﻿'   VBA Extractor - exports VB source code from macro enabled Word and Excel documents
'   Copyright (c) 2013 Tony Jollans & Neil Dodson

'   This program is free software; you can redistribute it and/or
'   modify it under the terms of the GNU General Public License
'   as published by the Free Software Foundation; either version 2
'   of the License, or (at your option) any later version.

'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.

'   You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

Option Explicit On
Option Strict On
Imports System.Runtime.InteropServices

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' These definitions use field names as documented by Microsoft; I make no comment other '
' than the obvious: that they need explanation.                                         '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Enum Directory_EntryType
    STGTY_Invalid
    STGTY_Storage
    STGTY_Stream
    STGTY_Lockbytes
    STGTY_Property
    STGTY_Root
End Enum

<StructLayout(LayoutKind.Sequential, Pack:=1)>
Public Structure StructuredStorageHeader        ' Microsoft definition for File Header
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)>
    Public abSig() As Byte        ' 0xd0 0xcf 0x11 0xe0 0 xa1 0xb1 0x1a 0xe1
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=16)>
    Public clid() As Byte
    Public uMinorVersion As Int16
    Public uDllVersion As Int16
    Public uByteOrder As Int16      ' 0xFFFE (0xFE 0xFF = Intel 'little-endian')
    Public uSectorShift As Int16      ' Log(2) of Sector Size (usually 9, = 512-byte sectors)
    Public uMiniSectorShift As Int16      ' Log(2) of Small Sector Size (usually 6, = 64-byte)
    Public usReserved As Int16      ' Must be zero
    Public ulReserved1 As Int32         ' Must be zero
    Public ulReserved2 As Int32         ' Must be zero
    Public csectFAT As Int32         ' Number of sectors used by the SAT
    Public sectDirStart As Int32         ' First Sector of the Directory
    Public ulDFsignature As Int32         ' Must be zero
    Public ulMiniSectorCutoff As Int32         ' Usually 4096
    Public sectMiniFatStart As Int32         ' First Sector of the SSAT
    Public csectMiniFat As Int32         ' Number of sectors used by the SSAT
    Public sectDifStart As Int32         ' First MSAT continuation sector
    Public csectDif As Int32         ' Number of MSAT continuation sectors
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=109)>
    Public sectFat() As Int32         ' First 109 entries of the MSAT

End Structure

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode, Pack:=1)>
Public Structure DirectoryEntry                 ' Microsoft definition for Directory Entry
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)>
    Public ab As String   ' Entry Name
    Public cb As Int16      ' Entry Name length (including trailing null)
    ' Microsoft explicitly say characters, but it is bytes
    Public mse As Byte         ' Entry Type.
    ' Enum above. Can't declare Byte as Enum in VBA
    Public bflags As Byte         ' 0 = Red, 1 = Black
    Public sidLeftSib As Int32         ' Id of Left Sibling Directory Entry
    Public sidRightSib As Int32         ' Id of Right Sibling Directory Entry
    Public sidChild As Int32         ' Id of Root Child Directory Entry
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=16)>
    Public clsid() As Byte
    Public dwUserFlags As Int32

    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)>
    Public time() As TimeElement

    Public sectStart As Int32         ' First Sector (or Short Sector) of Stream
    Public ulSize As Int32         ' Length of Stream
    Public dptPropType As Int32         ' Zero
End Structure

'ND todo - 2d array is transposed - this is here just to muddle through the deserialisation.
'The original VB6 code handles this properly though
Public Structure TimeElement
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)>
    Private items() As Byte
    Default Public ReadOnly Property Item(ByVal Index As Integer) As Byte
        Get
            Return items(Index)
        End Get
    End Property
End Structure

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' a mixed bag of definitions of 512 bytes, each to be used when appropriate            '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Structure NonSpecificSector
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=512)>
    Public SectorByte() As Byte
End Structure

Public Structure SectorOfDWords
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=128)>
    Public DWord() As Int32
End Structure

Public Structure ShortSector
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=64)>
    Public SSByte() As Byte
End Structure

Public Structure SectorOfShortSectors
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=8)>
    Public ShortSector() As ShortSector
End Structure

Public Structure StreamOfShortSectors
    Public ShortSector() As ShortSector
End Structure

Public Structure DirectorySector
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=4)>
    Public DirectoryEntry() As DirectoryEntry
End Structure

Public Structure DirectoryEntryLocal
    Public EntryName As String
    Public EntryType As Directory_EntryType
    Public RedOrBlack As Byte
    Public LeftSibling As Int32
    Public RightSibling As Int32
    Public RootChild As Int32
    Public FirstSector As Int32
    Public StreamLength As Int32
End Structure

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Declarations for dir Stream processing. Firstly a simple flag to control processing.  '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Enum RecordSeries
    RecordSeries_PROJECTINFORMATION
    RecordSeries_PROJECTREFERENCES
    RecordSeries_PROJECTMODULES
    RecordSeries_TERMINATOR
End Enum

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' All the record types are listed here. Most of the names are as given in the Microsoft '
' documentation; where these don't exist, I have tried to choose appropriate ones. For  '
' clarity, I have given the values as comments, which can be aligned without the VBE    '
' removing all the multiple spaces, and values are given in code only where necessary,  '
' because not all possible values are used. The actual (sub-)record types are 2-byte,   '
' Integer values, and the 4-byte Enumeration values are used as comparands only.        '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Enum RecordType

    PROJECTSYSKIND = &H1&                       ' 0001
    PROJECTLCID                                 ' 0002
    PROJECTCODEPAGE                             ' 0003
    PROJECTNAME                                 ' 0004
    PROJECTDOCSTRING                            ' 0005
    PROJECTHELPFILEPATH                         ' 0006
    PROJECTHELPCONTEXT                          ' 0007

    PROJECTLIBFLAGS                             ' 0008
    PROJECTVERSION                              ' 0009
    PROJECTCONSTANTS = &HC&                     ' 000C
    REFERENCEREGISTERED                         ' 000D
    REFERENCEPROJECT                            ' 000E
    MODULESCOUNT                                ' 000F

    TERMINATOR                                  ' 0010
    PROJECTCOOKIE = &H13&                       ' 0013
    PROJECTLCIDINVOKE                           ' 0014
    REFERENCENAME = &H16&                       ' 0016

    MODULENAME = &H19&                          ' 0019
    MODULESTREAMNAME                            ' 001A
    MODULEDOCSTRING = &H1C&                     ' 001C
    MODULEHELPCONTEXT = &H1E&                   ' 001E

    MODULETYPEMODULERECORD = &H21&              ' 0021
    MODULETYPECLASSMODULERECORD                 ' 0022
    MODULEREADONLY = &H25&                      ' 0025

    MODULEPRIVATE = &H28&                       ' 0028
    MODULETERMINATOR = &H2B&                    ' 002B
    MODULECOOKIE                                ' 002C
    REFERENCECONTROL = &H2F&                    ' 002F

    REFERENCEEXTENDED                           ' 0030
    MODULEOFFSET                                ' 0031
    MODULESTREAMNAMEUNICODE                     ' 0032
    REFERENCEORIGINAL                           ' 0033

    PROJECTCONSTANTSUNICODE = &H3C&             ' 003C
    PROJECTHELPFILEPATH2                        ' 003D
    REFERENCENAMEUNICODE                        ' 003E

    PROJECTDOCSTRINGUNICODE = &H40&             ' 0040
    MODULENAMEUNICODE = &H47&                   ' 0047

    MODULEDOCSTRINGUNICODE                      ' 0048
End Enum

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' These enumerations are not actually needed; they show possible values of some records '
' and, I hope, add a little clarity.                                                    '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Enum SysKind
    SysKind_16bitWindows
    SysKind_32bitWindows
    SysKind_Macintosh
    SysKind_64bitWindows
End Enum

Public Enum Lcid
    Lcid_US_English = &H409&
End Enum

Public Enum Codepage
    Windows_1252 = 1252
End Enum

Public Enum LibIdKind
    StandaloneWindowsFilePath = &H41&           ' 41
    StandaloneMacFilePath                       ' 42
    EmbeddedWindowsFilePath                     ' 43
    EmbeddedMacFilePath                         ' 44
    WindowsFilePath = &H47&                     ' 47
    MacFilePath                                 ' 48
End Enum

Public Enum LibIdType
    LibidTypeOrdinary
    LibidTypeTwiddled
    LibidTypeExtended
    LibidTypeProjectAbsolute
    LibidTypeProjectRelative
End Enum

Public Enum ModuleType
    ModuleTypeModule
    ModuleTypeClassModule
End Enum

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Typedefs for References.                                                              '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Class GUID
    Public Data1 As Int32
    Public Data2 As Int16
    Public Data3 As Int16
    Public Data4(7) As Byte
End Class

Public Structure LibId
    Public [Type] As LibIdType
    Public Kind As LibIdKind
    Public GUIDString As String
    Public MajorVersion As String
    Public MinorVersion As String
    Public Lcid As String
    Public Path As String
    Public RegName As String
End Structure

Public Structure ProjectLibId
    Public [Type] As LibIdType
    Public Kind As LibIdKind
    Public Path As String
End Structure

Public Structure RegisteredReference
    Public LibId As LibId
End Structure

Public Class ProjectReference
    Public ProjectLibId(0 To 1) As ProjectLibId
    Public MajorVersion As Int32
    Public MinorVersion As Int16
End Class

Public Class ControlReference
    Public LibId(0 To 2) As LibId
    Public ExtendedName As String
    Public OriginalTypeLib As New GUID
    Public OriginalTypeLibString As String
    Public Cookie As Int32
End Class

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Structures for the project information, references, and modules data.                 '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Public Structure ProjectInformation
    Public SysKind As SysKind
    Public Lcid As Lcid
    Public LcidInvoke As Lcid
    Public Codepage As Int16
    Public Name As String
    Public Description As String
    Public HelpFilePath As String
    Public HelpContext As Int32
    Public LibFlags As Int32
    Public VersionMajor As Int32
    Public VersionMinor As Int16
    Public Constants As String
End Structure

Public Class ProjectReferences
    Public Type As RecordType
    Public Name As String
    Public Registered As RegisteredReference
    Public Project As ProjectReference
    Public Control As New ControlReference

End Class

Public Structure ProjectModules
    Public Type As ModuleType
    Public Name As String
    Public [ReadOnly] As Boolean
    Public [Private] As Boolean
    Public StreamName As String
    Public Description As String
    Public Offset As Int32
    Public HelpContext As Int32
End Structure


